home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-19
/
surfsrc3.zip
/
INTRFILL.INC
< prev
next >
Wrap
Text File
|
1991-09-25
|
3KB
|
77 lines
procedure INTRFILL (Surf: word; Mat: integer; var Shades: nodearray);
{ Interpolated fillsurf routine for Gouraud shading }
var Npts: integer; { #points on edges of the surface }
Nextpt: integer; { Next point to use for filling }
Node1, Node2: word; { node numbers of endpts of line }
Xpt, Ypt: points; { pts on edges of surface }
Shpt: realpts; { shade at each point }
Vert: integer; { vertex number }
Shade1, Shade2: real; { Shades at endpoint nodes }
begin
{$ifdef BIGMEM}
with ptrd^ do with ptre^ do with ptrh^ do
with ptri^ do
begin
{$endif}
if (onscreen (Surf)) then begin
Npts := 0;
for Vert := 1 to Nvert[Surf]-1 do begin
Node1 := Konnec (Surf, Vert);
Node2 := Konnec (Surf, Vert+1);
Shade1 := Shades[Node1];
Shade2 := Shades[Node2];
if (Shade1 < Ambient[Mat]) then
Shade1 := Ambient[Mat];
if (Shade2 < Ambient[Mat]) then
Shade2 := Ambient[Mat];
storshades (round(Xtran[Node1]), round(Ytran[Node1]),
round(Xtran[Node2]), round(Ytran[Node2]),
Shade1, Shade2, Xpt, Ypt, Shpt, Npts);
if (Npts < 0) then
badsurf;
end; { for Vert }
{ One last line to close the polygon }
Node1 := Konnec (Surf, Nvert[Surf]); { last node }
Node2 := Konnec (Surf, 1); { first node }
Shade1 := Shades[Node1];
Shade2 := Shades[Node2];
if (Shade1 < Ambient[Mat]) then
Shade1 := Ambient[Mat];
if (Shade2 < Ambient[Mat]) then
Shade2 := Ambient[Mat];
storshades (round(Xtran[Node1]), round(Ytran[Node1]),
round(Xtran[Node2]), round(Ytran[Node2]),
Shade1, Shade2, Xpt, Ypt, Shpt, Npts);
if (Npts < 0) then
badsurf;
{ Sort the line segment points, first by Y, then by X }
shellshades (Xpt, Ypt, Shpt, Npts);
{ Now draw the filled surface }
Nextpt := 1;
while (Nextpt < Npts) do begin
if (abs(Xpt[Nextpt] - Xpt[Nextpt+1]) > 1) and
(Ypt[Nextpt] = Ypt[Nextpt+1]) then begin
intrdraw (Xpt[Nextpt], Xpt[Nextpt+1], Ypt[Nextpt], Mat,
Shpt[Nextpt], Shpt[Nextpt+1]);
Nextpt := Nextpt + 2;
end else begin
intrplot (Xpt[Nextpt], Ypt[Nextpt], Mat, Shpt[Nextpt]);
Nextpt := Nextpt + 1;
end;
end; { while }
if (Nextpt = Npts) then
intrplot (Xpt[Nextpt], Ypt[Nextpt], Mat, Shpt[Nextpt]);
end; { if onscreen }
{$ifdef BIGMEM}
end; {with}
{$endif}
end; { procedure INTRFILL }